home *** CD-ROM | disk | FTP | other *** search
/ Floppyshop 2 / Floppyshop - 2.zip / Floppyshop - 2.iso / art&graf.ix / art-0039 / source / dcprtcnv.mod < prev    next >
Text File  |  1997-04-16  |  15KB  |  453 lines
  1. IMPLEMENTATION MODULE  DCPrtCnv;
  2.  
  3. (*----------------------------------------------------------------------*)
  4. (*                                                                      *)
  5. (*  Version 1.00                July    1988            L.G. Miller     *)
  6. (*                                                                      *)
  7. (*  The fixed point accuracy is 11 bits ( 1 part in 2048 )              *)
  8. (*                                                                      *)
  9. (*----------------------------------------------------------------------*)
  10.  
  11.  
  12.  
  13. (* IMPORT Trace; *)
  14.  
  15. FROM SYSTEM             IMPORT ADR, ADDRESS, WORD, BYTE;
  16.  
  17. FROM DCGlobal           IMPORT HiResScreen,
  18.                                PrinterTypes,
  19.                    BITSPERWORD;
  20.  
  21. FROM DCQPicCnv        IMPORT QQryHRPixel;
  22.  
  23. CONST
  24.         CFixedPointScale = LONGINT(2048); (* must be power of 2 *)
  25.         CFixedPointShift = 11;
  26.  
  27. TYPE
  28.     LONGBITSET = SET OF [ 0 .. 31 ];
  29.  
  30.  
  31. VAR     PrinterToUse : PrinterTypes;
  32.  
  33.         (* these set up at NewPicture & maintained during conversion *)
  34.         InStartX, InStartY,
  35.         InEndX,   InEndY,
  36.  
  37.         OutNumberOfColumns : INTEGER; (* number of columns to be output *)
  38.  
  39.         PicXScaleFactor,
  40.         PicYScaleFactor    : INTEGER; (* CFixedPointScale times too big *)
  41.  
  42.         InNextLine      : LONGINT; (* Sum of scaled print intervals *)
  43.  
  44.         LastPrintLine,
  45.         NextPrintLine   : INTEGER;
  46.  
  47.         DirectionIsLandscape : BOOLEAN; (* TRUE ==> x is down the page *)
  48.  
  49.  
  50.  
  51. PROCEDURE QueryPicturePixel(     x, y : INTEGER ; (* co-ords *)
  52.                              VAR pic  : HiResScreen ) : BOOLEAN;
  53.   VAR  groupno, bitno : INTEGER;  
  54.        addr  : ADDRESS;
  55.  
  56.   BEGIN
  57.     groupno := x DIV BITSPERWORD;
  58.     bitno   := x MOD BITSPERWORD;
  59.     RETURN ( CARDINAL(bitno) IN pic[y][groupno] );
  60.   END QueryPicturePixel;
  61.  
  62.  
  63. (*----------------------------------------------------------------------*)
  64. (* Given relative print co-ordinates, calculate the relative picture    *)
  65. (* co-ordinates.                                                        *)
  66. (* Uses Global Constant CFixedPointScale & Global variables             *)
  67. (* PicXScaleFactor & PicYScaleFactor.                                   *)
  68. (*----------------------------------------------------------------------*)
  69. PROCEDURE GetRelPictureCoords(     PrintX, PrintY         : INTEGER;
  70.                                    ScaleX, ScaleY         : INTEGER;
  71.                                 VAR PicX, PicY            : INTEGER );
  72.   VAR px, py, lx, ly : LONGINT; 
  73.   BEGIN
  74.     px := LONG(PrintX);
  75.     py := LONG(PrintY);
  76.     PicX := SHORT( ( ( px * ScaleX ) DIV CFixedPointScale ));
  77.     PicY := SHORT( ( ( py * ScaleY ) DIV CFixedPointScale ));
  78.   END GetRelPictureCoords;
  79.  
  80.  
  81. PROCEDURE QueryPrinterToUse() : PrinterTypes;
  82.   BEGIN
  83.     RETURN PrinterToUse;
  84.   END QueryPrinterToUse;
  85.  
  86.  
  87. PROCEDURE SetPrinterToUse ( ptype : PrinterTypes );
  88.   BEGIN
  89.     PrinterToUse := ptype;
  90.   END SetPrinterToUse;
  91.  
  92.  
  93. PROCEDURE GetScaleFactor ( insize , outsize : INTEGER ) : INTEGER;
  94.   VAR li, lo : LONGINT;
  95.   BEGIN
  96.     li := LONG(insize); lo := LONG(outsize);
  97.     RETURN  SHORT( ( ( li * CFixedPointScale ) DIV lo ) );
  98.   END GetScaleFactor;
  99.  
  100.  
  101. (*----------------------------------------------------------------------*)
  102. (*  These routines set the global variables for subsequent conversion   *)
  103. (*----------------------------------------------------------------------*)
  104.  
  105. PROCEDURE SetGlobal ( InX, InY    : INTEGER; (* range of input *)
  106.                       PicWidth,
  107.                       PicHeight,
  108.                       PrintWidth,
  109.                       PrintHeight : INTEGER; (* 1 .. width *)
  110.                       Landscape   : BOOLEAN   (* true = sideways *)
  111.                      ) ;
  112.   VAR s : INTEGER;
  113.       ldepth, lnewwidth, lwidth : LONGINT;
  114.   BEGIN
  115.     InStartX := InX;
  116.     InStartY := InY;
  117.     InEndX   := InX + PicWidth - 1;
  118.     InEndY   := InY + PicHeight - 1;
  119.     DirectionIsLandscape := Landscape;
  120.     InNextLine           := 0;
  121.     NextPrintLine        := 0;
  122.  
  123.     IF Landscape THEN
  124.        OutNumberOfColumns   := PrintHeight;
  125.        LastPrintLine        := PrintWidth-1;
  126.  
  127.     ELSE
  128.        OutNumberOfColumns   := PrintWidth;
  129.        LastPrintLine        := PrintHeight-1;
  130.  
  131.     END;
  132.     PicXScaleFactor := GetScaleFactor(PicWidth, PrintWidth);
  133.     PicYScaleFactor := GetScaleFactor(PicHeight, PrintHeight);
  134.  
  135.   END SetGlobal;
  136.  
  137.  
  138.  
  139. PROCEDURE GetLandscape8BitSlice( VAR pic   : HiResScreen;
  140.                                  VAR buff  : ARRAY OF CHAR ) : BOOLEAN;
  141.   CONST CNoLines = 8;
  142.  
  143.   VAR   picx, picy                   : INTEGER;
  144.         prtx, prty                   : INTEGER;
  145.         disp                         : INTEGER;
  146.         BuffIndex                    : CARDINAL;
  147.         bitno                        : CARDINAL;
  148.         bitslice                     : LONGBITSET;
  149.  
  150.         chrptr                       : POINTER TO CHAR; (* cheat time *)
  151.   BEGIN
  152.     FOR BuffIndex := 0 TO SHORT(HIGH(buff)) DO buff[BuffIndex] := 0C END;
  153.  
  154.     BuffIndex := 0;
  155.  
  156.      (* every output bit is mapped to an input pixel *)
  157.     FOR prtx := 0 TO OutNumberOfColumns-1 DO (* y co-ord of picture *)
  158.  
  159.       bitslice := LONGBITSET{};
  160.       bitno    := 0;
  161.  
  162.       disp := 0;              (* number of lines printed this pass *)
  163.       prty := NextPrintLine;  (* print line *) (* x co-ord of picture *)
  164.  
  165.       REPEAT
  166.         GetRelPictureCoords( prty,            prtx,
  167.                              PicXScaleFactor, PicYScaleFactor,
  168.                              picx, picy );
  169.         INC(picx,InStartX);
  170.         picy := InEndY - picy;
  171.         IF QQryHRPixel( picx, picy, pic ) THEN
  172.            INCL(bitslice,bitno);
  173.         END;
  174.  
  175.         INC(bitno);
  176.         INC(disp);
  177.         INC(prty);
  178.       UNTIL ( disp >= CNoLines ) OR (  prty > LastPrintLine );
  179.  
  180.  
  181.            (* put characters in buffer - using a very dirty method *)
  182.  
  183.       IF BuffIndex <= HIGH(buff) THEN
  184.         chrptr := ADR(bitslice); (* i know its naughty *)
  185.         buff[BuffIndex] := chrptr^; (* top 8 bits *)
  186.         INC(BuffIndex);
  187.       END;
  188.  
  189.     END; (* for outcol *)
  190.  
  191.     INC(NextPrintLine,CNoLines);
  192.  
  193.     RETURN (  NextPrintLine >= LastPrintLine  );
  194.  
  195.   END GetLandscape8BitSlice;
  196.                                
  197.  
  198.  
  199. PROCEDURE GetLandscape24BitSlice( VAR pic   : HiResScreen;
  200.                                   VAR buff  : ARRAY OF CHAR
  201.                                   ) : BOOLEAN (* true in no more slices *);
  202.  
  203.   CONST CNoLines = 24;
  204.  
  205.   VAR   picx, picy                   : INTEGER;
  206.         prtx, prty                   : INTEGER;
  207.         disp                         : INTEGER;
  208.         BuffIndex                    : CARDINAL;
  209.         bitno                        : CARDINAL;
  210.         bitslice                     : LONGBITSET;
  211.  
  212.         chrptr                       : POINTER TO CHAR; (* cheat time *)
  213.   BEGIN
  214.     FOR BuffIndex := 0 TO SHORT(HIGH(buff)) DO buff[BuffIndex] := 0C END;
  215.  
  216.     BuffIndex := 0;
  217.  
  218.      (* every output bit is mapped to an input pixel *)
  219.     FOR prtx := 0 TO OutNumberOfColumns-1 DO (* y co-ord of picture *)
  220.  
  221.       bitslice := LONGBITSET{};
  222.       bitno    := 0;
  223.  
  224.       disp := 0;              (* number of lines printed this pass *)
  225.       prty := NextPrintLine;  (* print line *) (* x co-ord of picture *)
  226.  
  227.       REPEAT
  228.         GetRelPictureCoords( prty,            prtx,
  229.                              PicXScaleFactor, PicYScaleFactor,
  230.                              picx, picy );
  231.         INC(picx,InStartX);
  232.         picy := InEndY - picy;
  233.         IF QQryHRPixel( picx, picy, pic ) THEN
  234.            INCL(bitslice,bitno);
  235.         END;
  236.  
  237.         INC(bitno);
  238.         INC(disp);
  239.         INC(prty);
  240.       UNTIL ( disp >= CNoLines ) OR (  prty > LastPrintLine );
  241.  
  242.            (* put characters in buffer - using a very dirty method *)
  243.  
  244.       IF BuffIndex <= HIGH(buff) THEN
  245.         chrptr := ADR(bitslice); (* i know its naughty *)
  246.         buff[BuffIndex] := chrptr^; (* top 8 bits *)
  247.         chrptr := ADDRESS(LONGCARD(chrptr) + LONGCARD(1));
  248.         INC(BuffIndex);
  249.         buff[BuffIndex] := chrptr^; (* mid 8 bits *)
  250.         chrptr := ADDRESS(LONGCARD(chrptr) + LONGCARD(1));
  251.         INC(BuffIndex);
  252.         buff[BuffIndex] := chrptr^; (* bot 8 bits *)
  253.         INC(BuffIndex);
  254.       END;
  255.  
  256.     END; (* for outcol *)
  257.  
  258.     INC(NextPrintLine,CNoLines);
  259.  
  260.     RETURN (  NextPrintLine >= LastPrintLine  );
  261.  
  262.   END GetLandscape24BitSlice;
  263.                                
  264.  
  265.  
  266. PROCEDURE GetPortrait24BitSlice( VAR pic   : HiResScreen;
  267.                                  VAR buff  : ARRAY OF CHAR ) : BOOLEAN;
  268.  
  269.   CONST CNoLines = 24;
  270.  
  271.   VAR   picx, picy                   : INTEGER;
  272.         prtx, prty                   : INTEGER;
  273.         disp                         : INTEGER;
  274.         BuffIndex                    : CARDINAL;
  275.         bitno                        : CARDINAL;
  276.         bitslice                     : LONGBITSET;
  277.  
  278.         chrptr                       : POINTER TO CHAR; (* cheat time *)
  279.   BEGIN
  280.     FOR BuffIndex := 0 TO SHORT(HIGH(buff)) DO buff[BuffIndex] := 0C END;
  281.  
  282.     BuffIndex := 0;
  283.  
  284.      (* every output bit is mapped to an input pixel *)
  285.     FOR prtx := 0 TO OutNumberOfColumns-1 DO
  286.  
  287.       bitslice := LONGBITSET{};
  288.       bitno    := 0;
  289.  
  290.       disp := 0;              (* number of lines printed this pass *)
  291.       prty := NextPrintLine;  (* print line *)
  292.  
  293.       REPEAT
  294.         GetRelPictureCoords( prtx,              prty,
  295.                              PicXScaleFactor,   PicYScaleFactor,
  296.                              picx, picy );
  297.         INC(picx,InStartX);
  298.         INC(picy,InStartY);
  299.         IF QQryHRPixel( picx, picy, pic ) THEN
  300.            INCL(bitslice,bitno);
  301.         END;
  302.  
  303.         INC(bitno);
  304.         INC(disp);
  305.         INC(prty);
  306.       UNTIL ( disp >= CNoLines ) OR (  prty > LastPrintLine );
  307.  
  308.            (* put characters in buffer - using a very dirty method *)
  309.  
  310.       IF BuffIndex <= HIGH(buff) THEN
  311.         chrptr := ADR(bitslice); (* i know its naughty *)
  312.         buff[BuffIndex] := chrptr^; (* top 8 bits *)
  313.         chrptr := ADDRESS(LONGCARD(chrptr)+LONGCARD(1));
  314.         INC(BuffIndex);
  315.         buff[BuffIndex] := chrptr^; (* mid 8 bits *)
  316.         chrptr := ADDRESS(LONGCARD(chrptr)+LONGCARD(1));
  317.         INC(BuffIndex);
  318.         buff[BuffIndex] := chrptr^; (* bot 8 bits *)
  319.         INC(BuffIndex);
  320.       END;
  321.  
  322.     END; (* for outcol *)
  323.  
  324.     INC(NextPrintLine,CNoLines);
  325.  
  326.     RETURN (  NextPrintLine >= LastPrintLine  );
  327.  
  328.   END GetPortrait24BitSlice;
  329.                                
  330.  
  331.  
  332. PROCEDURE GetPortrait8BitSlice( VAR pic   : HiResScreen;
  333.                                 VAR buff  : ARRAY OF CHAR ) : BOOLEAN;
  334.   CONST CNoLines = 8;
  335.  
  336.   VAR   picx, picy                   : INTEGER;
  337.         prtx, prty                   : INTEGER;
  338.         disp                         : INTEGER;
  339.         BuffIndex                    : CARDINAL;
  340.         bitno                        : CARDINAL;
  341.         bitslice                     : LONGBITSET;
  342.  
  343.         chrptr                       : POINTER TO CHAR; (* cheat time *)
  344.   BEGIN
  345.     FOR BuffIndex := 0 TO SHORT(HIGH(buff)) DO buff[BuffIndex] := 0C END;
  346.  
  347.     BuffIndex := 0;
  348.  
  349.      (* every output bit is mapped to an input pixel *)
  350.     FOR prtx := 0 TO OutNumberOfColumns-1 DO
  351.  
  352.       bitslice := LONGBITSET{};
  353.       bitno    := 0;
  354.  
  355.       disp := 0;              (* number of lines printed this pass *)
  356.       prty := NextPrintLine;  (* print line *)
  357.  
  358.       REPEAT
  359.         GetRelPictureCoords( prtx,              prty,
  360.                              PicXScaleFactor,   PicYScaleFactor,
  361.                              picx, picy );
  362.         INC(picx,InStartX);
  363.         INC(picy,InStartY);
  364.         IF QQryHRPixel( picx, picy, pic ) THEN
  365.            INCL(bitslice,bitno);
  366.         END;
  367.  
  368.         INC(bitno);
  369.         INC(disp);
  370.         INC(prty);
  371.       UNTIL ( disp >= CNoLines ) OR (  prty > LastPrintLine );
  372.  
  373.            (* put characters in buffer - using a very dirty method *)
  374.  
  375.       IF BuffIndex <= HIGH(buff) THEN
  376.         chrptr := ADR(bitslice); (* i know its naughty *)
  377.         buff[BuffIndex] := chrptr^; (* bot 8 bits *)
  378.         INC(BuffIndex);
  379.       END;
  380.  
  381.     END; (* for outcol *)
  382.  
  383.     INC(NextPrintLine,CNoLines);
  384.  
  385.    RETURN (  NextPrintLine >= LastPrintLine  );
  386.  
  387.   END GetPortrait8BitSlice;
  388.  
  389.  
  390. PROCEDURE PrtCnv8BitSlice ( NewPicture     : BOOLEAN; (* TRUE is restart *)
  391.                             VAR last       : BOOLEAN; (* TRUE if end *)
  392.                             VAR picture    : HiResScreen;
  393.                                 InX, InY,
  394.                                 PicWidth,
  395.                                 PicHeight,
  396.                                 PrintWidth,
  397.                                 PrintHeight: INTEGER; (*  *)
  398.                                 Landscape  : BOOLEAN;  (* true = sideways *)
  399.                             VAR buffer     : ARRAY OF CHAR (* out *)
  400.                             );
  401.   BEGIN
  402.     IF NewPicture THEN
  403.        SetGlobal(  InX, InY, PicWidth, PicHeight,
  404.                       PrintWidth, PrintHeight,
  405.                       Landscape );
  406.     END;
  407.  
  408.     IF DirectionIsLandscape THEN
  409.  
  410.        last := GetLandscape8BitSlice( picture, buffer );
  411.  
  412.     ELSE
  413.  
  414.        last := GetPortrait8BitSlice( picture, buffer );
  415.     END;
  416.  
  417.   END PrtCnv8BitSlice;
  418.  
  419.  
  420.  
  421. PROCEDURE PrtCnv24BitSlice ( NewPicture     : BOOLEAN; (* TRUE is restart *)
  422.                              VAR last       : BOOLEAN; (* TRUE if end *)
  423.                              VAR picture    : HiResScreen;
  424.                                  InX, InY,
  425.                                  PicWidth,
  426.                                  PicHeight,
  427.                                  PrintWidth,
  428.                                  PrintHeight: INTEGER; (* *)
  429.                                  Landscape  : BOOLEAN;  (* true = sideways*)
  430.                              VAR buffer     : ARRAY OF CHAR (* out *)
  431.                             );
  432.   BEGIN
  433.     IF NewPicture THEN
  434.        SetGlobal(  InX, InY, PicWidth, PicHeight,
  435.                    PrintWidth, PrintHeight,
  436.                    Landscape );
  437.     END; (* if *)
  438.  
  439.     IF DirectionIsLandscape THEN
  440.  
  441.        last := GetLandscape24BitSlice( picture, buffer );
  442.  
  443.     ELSE
  444.  
  445.        last := GetPortrait24BitSlice( picture, buffer );
  446.     END;
  447.  
  448.   END PrtCnv24BitSlice;
  449.  
  450.  
  451. END DCPrtCnv.
  452.  
  453.